home *** CD-ROM | disk | FTP | other *** search
/ Aminet 12 / Aminet 12 (1996)(GTI - Schatztruhe)[!][Jun 1996].iso / Aminet / dev / lang / HeliOS3.lha / helios_demo_disk3 / source / Tutorial.src < prev   
Encoding:
Text File  |  1995-12-08  |  7.8 KB  |  238 lines
  1.  
  2.   \ Note that this example program does not make use of include symbols,
  3.   \ in order to allow it to be run on any HeliOS system.
  4.  
  5.  
  6.   FORGET **CORE**           \ Clear the user dictionary
  7.  
  8.   0. DVARIABLE SCREEN       \ Screen handle storage variable
  9.   0. DVARIABLE WINDOW       \ Window handle storage variable
  10.  
  11.   0. DVARIABLE BITMAP       \ Variables to store useful values, which.
  12.   0. DVARIABLE RASTPORT     \ are collected at startup time in case of
  13.   0. DVARIABLE VIEW         \ the need to use them later in graphics
  14.   0. DVARIABLE VIEWPORT     \ related functions.
  15.  
  16.  
  17.   \ OPENSYSTEM - Opens a screen and a window and sets up Input/Output.
  18.   \              Includes an example of how to make an Amiga library call.
  19.   \              Returns "1" on the stack for success and "0" for failure
  20.  
  21.  
  22.   : OPENSYSTEM              \ Start a word definition, the new word is
  23.                             \ called, appropriately, "OPENSYSTEM"
  24.  
  25.    TIMEOFF                  \ Disable the time display in the Interactive
  26.                             \ HeliOS screen
  27.  
  28.    0 HISTORY                \ Disable the line editor's circular buffer
  29.  
  30.    1 BAKSET                 \ Enable creation of Backup files on all disk
  31.                             \ SAVE operations - a useful safety feature
  32.  
  33.    \ These are all "general purpose" startup operations often used
  34.  
  35.  
  36.    1 STDSCREEN              \ Initialises a standard NewScreen structure
  37.                             \ and sets Hires mode
  38.  
  39.    LIT$ $Tutorial Screen$   \ Specify the screen title bar text
  40.  
  41.    640 250                  \ Specify screen width and height
  42.  
  43.    3                        \ Depth of screen (= number of bitplanes)
  44.  
  45.    OPENSCREEN               \ Open a screen using the initialised structure
  46.  
  47.    SCREEN D!                \ Store the screen handle/pointer
  48.  
  49.    SCREEN D@                \ Get SCREEN 32-bit pointer onto stack
  50.  
  51.  
  52.    D0>                      \ Test if SCREEN is greater than zero
  53.                             \ This checks to see if screen opened OK
  54.                             \ If SCREEN is zero we have trouble.......
  55.  
  56.    IF                       \ If SCREEN is not zero we are OK.........
  57.  
  58.  
  59.       SCREEN D@             \ Get 32-bit pointer to screen
  60.  
  61.       44.                   \ Put double length number 44 on stack
  62.  
  63.       D+                    \ Add this to screen pointer to give
  64.                             \ ViewPort pointer
  65.  
  66.       VIEWPORT D!           \ Store the ViewPort for the new screen
  67.  
  68.       STDWINDOW             \ Initialise a standard NewWindow structure
  69.  
  70.       HFWINDOW              \ Modify the standard window for it to appear
  71.                             \ on the HeliOS Screen
  72.  
  73.       SCREEN D@             \ Get screen again
  74.  
  75.       WINDOWSTRUCT          \ Returns 16-bit pointer to NewWindow
  76.  
  77.       30 +                  \ Add 30 to this
  78.  
  79.       D!                    \ Store screen pointer into NewWindow structure
  80.  
  81.       LIT$ $Tutorial Window$ \ Title bar text for window
  82.  
  83.       0 12 640 238          \ Guess what....Window dimensions!
  84.       3                     \ 3 BitPlanes
  85.       0                     \ No SUPERBITMAP
  86.       OPENWINDOW            \ Open the new window
  87.  
  88.       WINDOW D!             \ and store window pointer/handle
  89.  
  90.       WINDOW D@             \ Check if opened OK, like screen above
  91.  
  92.       D0>                   \ See "screen open" check above........
  93.  
  94.       IF
  95.  
  96.         WINDOW D@
  97.         MAKEGFXWINDOW       \ Enable graphics in this window
  98.  
  99.         WINDOW D@
  100.         MAKEOUTWINDOW       \ Enable text output to this window
  101.  
  102.         WINDOW D@
  103.         MAKEINWINDOW        \ Enable user input from this window
  104.  
  105.         WINDOW D@           \ Get Window pointer
  106.  
  107.         50. D+              \ Add 50 to Window Pointer to get RastPort
  108.  
  109.         D@L                 \ Get RASTPORT pointer
  110.  
  111.         RASTPORT D!         \ Get Window's RastPort, and store it in
  112.                             \ variable RASTPORT
  113.  
  114.         RASTPORT D@
  115.         4. D+ D@L
  116.         BITMAP D!           \ Get the bitmap from the stored RastPort
  117.  
  118.         INTUBASE            \ Put on the stack the 16-bit address
  119.                             \  where the 32-bit pointer to Intuition
  120.                             \  library base is stored
  121.  
  122.         -294                \ Put on the stack the offset of the library
  123.                             \  call "ViewAddress"
  124.  
  125.         LIBRARY             \ Call Intuition Library function to get
  126.                             \ VIEW pointer
  127.  
  128.         D0RESULT            \ Get dummy register D0 value which is the
  129.                             \   View address returned from the library call
  130.  
  131.         VIEW D!             \ Store pointer in variable VIEW
  132.  
  133.         1                   \ Put value "1" on stack to indicate that
  134.                             \ everything opened OK
  135.      ELSE
  136.         0                   \ Put "0" on stack to indicate failure
  137.      THEN
  138.    ELSE
  139.      0                      \ Put "0" on stack to indicate failure
  140.    THEN
  141.    ;                        \ End of Colon Definition
  142.  
  143.  
  144.   \ In a similar manner we have a defined a HeliOS word for the related
  145.   \ close down routine -
  146.  
  147.  
  148.    : CLOSESYSTEM               \ Start the colon definition
  149.  
  150.    FORTHINWINDOW               \ Redirect the input and output from
  151.    FORTHOUTWINDOW              \ program's window back to the HeliOS
  152.    FWINDOW MAKEGFXWINDOW       \ interactive environment
  153.  
  154.    WINDOW D@                   \ Get contents of window handle store
  155.    DFLAG                       \ Check and if Non-Zero put 1 on stack else
  156.                                \  put 0 on stack above window handle
  157.  
  158.          IF                    \ If window is open, ie handle is non zero
  159.            CLOSEWINDOW         \ Close it
  160.            WINDOW D0!          \ then set store to zero
  161.          ELSE
  162.             DDROP              \ else cleanup stack (drop window handle)
  163.          THEN                  \ end of If/Then structure
  164.  
  165.    SCREEN D@                   \ Look at screen handle
  166.    DFLAG IF                    \ If screen is open......
  167.            CLOSESCREEN
  168.            SCREEN D0!
  169.          ELSE
  170.            DDROP
  171.          THEN
  172.  
  173.    TIMEON                      \ Enable time display for the
  174.                                \ Interactive HeliOS screen
  175.                                \ before exiting
  176.  
  177.    ;                           \ End of colon definition
  178.  
  179.  
  180.   \ Now we can use these functions in a small program:
  181.  
  182.  
  183.   : TUTORIALPROGRAM
  184.  
  185.   OPENSYSTEM                        \ Open environment, returning 1 or 0
  186.                                     \ indicating success or failure
  187.  
  188.   IF                                \ If 1 is returned, for "success"
  189.  
  190.     1 GFXSETOPEN                    \ Set graphics outline pen colour to 1
  191.  
  192.     1 GFXOUTLINE                    \ Switch on graphics OUTLINE mode
  193.  
  194.     2 GFXSETAPEN                    \ Set graphics pen to "2" for circle
  195.  
  196.     400 160 80 40                   \ Circle coordinates
  197.  
  198.     GFXAREAELLIPSE                  \ Draw circle into off screen buffer
  199.  
  200.     GFXAREAEND                      \ Render circle to screen
  201.  
  202.     0 GFXOUTLINE                    \ Switch off graphics OUTLINE mode
  203.  
  204.     3 GFXSETAPEN                    \ Set graphics pen to "3" for text
  205.  
  206.     100 200 GFXMOVE                 \ Set graphics pen position
  207.  
  208.     LIT$ $This is graphic text$     \ Text string
  209.  
  210.     COUNT                           \ Get text start and length
  211.  
  212.     GFXTEXT                         \ Output text
  213.  
  214.  
  215.     20 10 CURPUT                    \ Place cursor
  216.  
  217.     ." Hello....Press <SPACE> to exit!"  \ Some console text output
  218.  
  219.  
  220.     BEGIN                    \ Start a BEGIN/UNTIL construct
  221.  
  222.       KEY                    \ Wait for a keypress
  223.  
  224.       32                     \ ASCII code for <SPACE> is 32
  225.  
  226.       =                      \ See if KEY value = 32
  227.  
  228.     UNTIL                    \ Loop until result is TRUE
  229.  
  230.   THEN
  231.  
  232.   CLOSESYSTEM                \ Close environment
  233.   ;
  234.  
  235.   TUTORIALPROGRAM            \ Actually execute our new "program" word.
  236.  
  237.  \ End of program
  238.